perm filename INPSS.F4[DRW,LCS] blob
sn#056115 filedate 1974-12-13 generic text, type T, neo UTF8
00100 DIMENSION BUF1(1000),BUF2(1000)
00200 COMMON X(100),Y(100),N,X1(512),Y1(512),S(100),K
00300 DATA Z/20./,ZZ/20./,XX/60./
00400 10 TYPE 1
00500 ACCEPT 2,X
00600 1 FORMAT(' TYPE PAIRS OF NUMS.'/)
00700 2 FORMAT(100F)
00800 DO 3 K=1,100,2
00900 IF(X(K).EQ.999.)GO TO 4
01000 X(K/2+1)=X(K)
01100 Y(K/2+1)=X(K+1)
01200 3 CONTINUE
01300 4 N=K/2
01400 CALL DPYSET(1,BUF1,1000)
01500 CALL AIVECT(IFIX(X(1)*Z),IFIX(Y(1)*Z))
01600 DO 6 K=2,N
01700 6 CALL AVECT(IFIX(X(K)*Z),IFIX(Y(K)*Z))
01800 CALL DPYOUT(1)
01900 CALL SS
02000 CALL DPYSET(2,BUF2,1000)
02100 CALL AIVECT(IFIX(X1(1)*ZZ+XX),IFIX(Y1(1)*ZZ))
02200 DO 5 K=2,512
02300 5 CALL AVECT(IFIX(X1(K)*ZZ+XX),IFIX(Y1(K)*ZZ))
02400 CALL DPYOUT(2)
02500 GO TO 10
02600 END